Software Vault: The Diamond Collection/The Diamond Collection (Software Vault)(Digital Impact).ISO/cdr49/dispwet1.zip/DISPWET.WCC

Text File | 1995-02-17 | 5KB | 236 lines

REM WCcode module for downloading individual weather maps or packages.
REM Written by Mark Davis, Crystal Wind Communications, Inc in Jan 1995
REM Released as SHARE-WITH-ME-WARE, if you like it, use it, share
REM something you've done with me. Fido 1:3653/66 BBS 904-564-0101
REM Enjoy...


dim GRmode as integer
dim REQ as string

SUB DispInst
   CLS
   if not DisplayFile("weathins") then
      Print "Instructions are not available at this time."
      Print "Please Notify Sysop."
      Delay 1
      waitenter
   end if
End Sub

Function Grafmode (testGRmode as Integer) as Integer
    if (RipDetected and RipEnabled) then
       testGRmode = 2
       GOTO FINI
    end if
    if (AnsiDetected and AnsiEnabled) then
       testGRmode = 1
       GOTO FINI
    end if
       TestGRmode = 0
FINI:
End Function

SUB DispMenu
CLS
    If not DisplayFile("Weathmen") then
       CLS
       Print "Missing Menu"
       Print "Please Notify Sysop"
       Delay 1
       Print "Exiting Program"
       END
    end if
End Sub

Sub Sendit (file2send as string)
Dim tchoice as string*1
Dim thisone as string
CLS
Z1:
Print : Print : Print
Print "[G]IF or [P]CX format, or [Q] to Quit";
Input tchoice
If ucase(tchoice) = "G" then
   thisone = "D:\WEATHER\SINGLES\" + file2send + ".GIF"
end if
If ucase(tchoice) = "P" then
   thisone = "D:\WEATHER\SINGLES\" + file2send + ".PCX"
end if
If ucase(tchoice) = "Q" then
   exit sub
end if
sendfile(thisone)
end sub

Sub DispSubmenu1
T1:
Dim Inchoice1 as String*1
RES1:
Inchoice1 = ""
CLS
    If not DisplayFile("Individ") then
       CLS
       Print "Missing Menu"
       Print "Please Notify Sysop"
       Delay 1
       Print "Exiting menu"
       exit sub
    End If
    Print
    Print "Please Enter your choice >> ";
    input Inchoice1
    If Ucase(Inchoice1) = "M" then
          gotomenu("MAIN MENU")
          END
    end if
    If Ucase(Inchoice1) = "W" then
          gotomenu("WEATHER SERVICES MENU")
          END
    end if
    If Ucase(Inchoice1) = "S" then
          gotomenu("SERVICES & GAMES MENU")
          END
    end if
    If Ucase(Inchoice1) = "P" then
          REQ = "2"
          exit sub
    end if
    Select Case Ucase(Inchoice1)
         Case "0"
            Sendit("F24H")
         Case "1"
            Sendit("1EWX")
         Case "2"
            Sendit("2EWX")
         Case "3"
            Sendit("SNUS")
         Case "4"
            Sendit("P2US")
         Case "5"
            Sendit("HTM1")
         Case "6"
            Sendit("HTM2")
         Case "7"
            Sendit("LTM1")
         Case "8"
            Sendit("LTM2")
         Case "9"
            Sendit("RUS_")
         Case "A"
            Sendit("RNC_")
         Case "B"
            Sendit("RNE_")
         Case "C"
            Sendit("RNW_")
         Case "D"
            Sendit("RSC_")
         Case "E"
            Sendit("RSE_")
         Case "F"
            Sendit("RSW_")
         Case "G"
            Sendit("SE00")
         Case "H"
            Sendit("SE01")
         Case "I"
            Sendit("SU00")
         Case "J"
            Sendit("SU01")
    End Select
    goto T1
End Sub

Sub DispSubmenu2
T2:
Dim Inchoice2 as String*1
RES2:
Inchoice2 = ""
CLS
    If not DisplayFile("Package") then
       CLS
       Print "Missing Menu"
       Print "Please Notify Sysop"
       Delay 1
       Print "Exiting menu"
       exit sub
    End If
    Print
    Print "Please Enter your choice >> ";
    input Inchoice2
    If Ucase(Inchoice2) = "M" then
          gotomenu("MAIN MENU")
          END
    end if
    If Ucase(Inchoice2) = "W" then
          gotomenu("WEATHER SERVICES MENU")
          END
    end if
    If Ucase(Inchoice2) = "S" then
          gotomenu("SERVICES & GAMES MENU")
          END
    end if
    If Ucase(Inchoice2) = "I" then
          REQ = "1"
          exit sub
    end if
    Select Case Ucase(Inchoice2)
         Case "1"
            Sendfile("d:\weather\weathmap.zip")
         Case "2"
            Sendfile("d:\weather\radar.zip")
         Case "3"
            Sendfile("d:\weather\satelite.zip")
         Case "4"
            Sendfile("d:\weather\singles\show.exe")
End Select
goto T2
End Sub

Function Prompter(request as string) as string
dim askline(2) as string*78
if GRmode=0 then
   askline(1)="Please enter your command request, [I] for instructions,"
   askline(2)="or [Q] to quit  >>"
end if
if GRmode=1 then
   askline(1)="@0F@Please enter your command request, [@0A@I@0F@] for instructions,"
   askline(2)="@0F@or [@0A@Q@0F@] to quit  @0A@>>@0F@"
end if
if GRmode=2 then
   askline(1)="@0F@Please enter your command request,[@0A@^T1I@0F@] for instructions,"
   askline(2)="@0F@or [@0A@^T1Q@0F@] to quit  @0A@>>@0F@"
end if
print askline(1)
print askline(2);
input request

End Function

PROGRAM:
CLS
GRAFMODE(grmode)
TOP:
DISPMENU
PROMPTER(REQ)
Select case REQ
    Case "Q","q"
       END
    Case "I","i"
       DispInst
       GOTO TOP
    Case "1"
RERUN1:
       DispSubmenu1
       If REQ = "2" then
          goto RERUN2
       end if
    Case "2"
RERUN2:
       DispSubmenu2
       If REQ = "1" then
          goto RERUN1
       end if
End Select
GOTO TOP